home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / pkey12_1.zip / CW.LSP < prev    next >
Text File  |  1992-09-13  |  2KB  |  66 lines
  1. ;Commercial window program (very simplistic)
  2. ;
  3. ;
  4. (setq oer *error* *error* err) 
  5. (pre)
  6. (if (= os1 nil)(setq os1 36))
  7. (setq dfop1 os1)
  8. (initget (+ 2 4))
  9. (setq os1(getdist(strcat "Enter window opening size <" (rtos os1) ">: ")))
  10. (if (= os1 nil)(setq os1 dfop1))
  11. (initget 1 "Left Right Center")
  12. (setq an1(getkword "Break from Left/Right/Center: "))
  13. (setq ent1 (entsel "\nPick break point: "))
  14. (if(= ent1 nil)(ref))
  15. (setq e1 (car ent1))
  16. (setq p1 (car (cdr ent1)))
  17. (setq p1 (osnap p1 "near"))
  18. (setq et1a(cdr (assoc 0 (entget e1))))
  19. (if (= et1a "POLYLINE")(PRINC "\n******   CAN NOT EDIT POLYLINE, EXPLODE AND TRY AGAIN.  ******"))
  20. (setq lyrnm (cdr (assoc 8 (entget e1))))
  21. (setq startpt (cdr (assoc 10 (entget e1))))
  22. (setq endpt (cdr (assoc 11 (entget e1))))
  23. (setq temp1 (osnap p1 "mid"))
  24. (setq atemp (angle (osnap p1 "end") temp1))
  25. (setq temp1 (polar p1 atemp 8))
  26. (setvar "aperture" 60)
  27. (entdel e1)
  28. (setq temp2(osnap temp1 "near"))
  29. (entdel e1)
  30. (setvar "aperture" 4)
  31. (setq up (/ pi 2))
  32. (setq dn (* pi 1.5))
  33. (setq a1 (angle startpt endpt))
  34. (cond((= an1 "Left")(if(and (> a1 up)(<= a1 dn))(setq a1 (- a1 pi))))
  35.      ((= an1 "Right")(if(or (<= a1 up)(> a1 dn))(setq a1 (+ a1 pi))))
  36.      ((= an1 "Center")(setq p1(polar p1 a1 (* (/ os1 2) -1.0)))))
  37. (setq a2 (angle temp1 temp2))
  38. (setq p2 (polar p1 a1 os1))
  39. (setq p3 (polar p1 a2 (distance temp1 temp2)))
  40. (setq p4 (polar p2 a2 (distance temp1 temp2)))
  41. (command "layer" "M" lyrnm "")
  42. (command "break" e1 p1 p2)
  43. (command "break" p3 "f" p3 p4)
  44. (command "line" p2 p4 "")
  45. (command "line" p1 p3 "")
  46. (setq halfwidth (/ (distance p1 p3) 2.0))
  47. (setq p15 (polar p1 a1 2.0))
  48. (setq p16 (polar p3 a1 2.0))
  49. (setq p17 (polar p2 a1 -2.0))
  50. (setq p18 (polar p4 a1 -2.0))  
  51. (setq p7a (polar p15 a2 halfwidth))
  52. (setq p8a (polar p17 a2 halfwidth))
  53. (setq p7 (polar p7a a2 -0.5))
  54. (setq p8 (polar p8a a2 -0.5))
  55. (setq p9 (polar p7 a2 1.0))
  56. (setq p10 (polar p8 a2 1.0))
  57. (command "layer" "M" "wd" "")
  58. (command "line" p1 p2 "")
  59. (command "line" p3 p4 "")
  60. (command "line" p7 p8 "")
  61. (command "line" p9 p10 "")
  62. (command "line" p15 p16 "")
  63. (command "line" p17 p18 "")
  64. (setq an1 nil os1 nil ent1 nil e1 nil p1 nil et1a nil lyrnm nil startpt nil endpt nil temp1 nil atemp nil up nil dn nil a1 nil a2 nil p2 nil p3 nil p4 nil p15 nil p16 nil p17 nil p18 nil p7a nil p8a nil p7 nil p8 nil p9 nil p10 nil)
  65. (post)
  66. (princ)